home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1994 June / PC Plus Super CD coverdisc Issue 93 June 1994.iso / suprdisk / button / frmbitma.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-03-26  |  9.8 KB  |  265 lines
  1. VERSION 2.00
  2. Begin Form frmBitMap 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Master BitMap"
  5.    ClientHeight    =   4965
  6.    ClientLeft      =   2730
  7.    ClientTop       =   2085
  8.    ClientWidth     =   3525
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    Height          =   5655
  12.    Left            =   2670
  13.    LinkTopic       =   "Form1"
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   331
  16.    ScaleMode       =   3  'Pixel
  17.    ScaleWidth      =   235
  18.    Top             =   1455
  19.    Width           =   3645
  20.    Begin VScrollBar vsrPosition 
  21.       Enabled         =   0   'False
  22.       Height          =   1860
  23.       Left            =   0
  24.       TabIndex        =   6
  25.       Top             =   0
  26.       Value           =   1
  27.       Width           =   390
  28.    End
  29.    Begin PictureBox picCol16 
  30.       AutoRedraw      =   -1  'True
  31.       AutoSize        =   -1  'True
  32.       Height          =   45
  33.       Left            =   4575
  34.       Picture         =   FRMBITMA.FRX:0000
  35.       ScaleHeight     =   15
  36.       ScaleWidth      =   15
  37.       TabIndex        =   5
  38.       Top             =   675
  39.       Visible         =   0   'False
  40.       Width           =   45
  41.    End
  42.    Begin PictureBox picSwap 
  43.       Height          =   735
  44.       Left            =   3675
  45.       ScaleHeight     =   47
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   99
  48.       TabIndex        =   4
  49.       Top             =   1440
  50.       Visible         =   0   'False
  51.       Width           =   1515
  52.    End
  53.    Begin HScrollBar HScroll1 
  54.       Height          =   240
  55.       Left            =   375
  56.       TabIndex        =   3
  57.       Top             =   1665
  58.       Width           =   2040
  59.    End
  60.    Begin VScrollBar VScroll1 
  61.       Height          =   1680
  62.       Left            =   2250
  63.       TabIndex        =   2
  64.       Top             =   0
  65.       Width           =   390
  66.    End
  67.    Begin PictureBox picFrame 
  68.       BorderStyle     =   0  'None
  69.       Height          =   1635
  70.       Left            =   450
  71.       ScaleHeight     =   109
  72.       ScaleMode       =   3  'Pixel
  73.       ScaleWidth      =   136
  74.       TabIndex        =   0
  75.       Top             =   0
  76.       Width           =   2040
  77.       Begin PictureBox picBitMap 
  78.          AutoRedraw      =   -1  'True
  79.          BackColor       =   &H00C0C0C0&
  80.          Height          =   2580
  81.          Left            =   0
  82.          ScaleHeight     =   170
  83.          ScaleMode       =   3  'Pixel
  84.          ScaleWidth      =   364
  85.          TabIndex        =   1
  86.          Top             =   0
  87.          Width           =   5490
  88.       End
  89.    End
  90.    Begin Menu mnuExit 
  91.       Caption         =   "E&xit"
  92.    End
  93.    Begin Menu mnuEdit 
  94.       Caption         =   "&Edit"
  95.    End
  96.    Begin Menu mnuDelete 
  97.       Caption         =   "&Delete"
  98.    End
  99. Option Explicit
  100. Dim LastPosition As Integer
  101. Dim TotalButtonHeight As Integer
  102. Dim Clicked As Integer
  103. Dim Changing As Integer
  104. Sub Form_Activate ()
  105.     TotalButtonHeight = Bitmap.ButtonHeight + (Bitmap.Border * 2)
  106.     VScroll1.LargeChange = TotalButtonHeight
  107.     VScroll1.Value = VScroll1.Min
  108.     HelpItem = 15
  109. End Sub
  110. Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
  111.     If KeyCode = &H70 Then Cheap_Help Format$(HelpItem)
  112. End Sub
  113. Sub Form_KeyPress (KeyAscii As Integer)
  114.     mnuExit_Click
  115. End Sub
  116. Sub Form_Load ()
  117.     Position_Form frmBitMap
  118.     'To make the Master Bitmap picture contain a palette compatible
  119.     'with the buttons created by VB, I created picCol16 which is 1 pixel saved as a
  120.     '16 color bitmap.
  121.     picBitMap = picCol16
  122.     picSwap = picCol16
  123.     KeyPreview = True
  124. End Sub
  125. '  Adapted from code in the Visual Basic Help file
  126. '   Select Help
  127. '   then 'Obtaining Technical Support'
  128. '   then 'Knowledge Based Articles on Visual Basic'
  129. '   then 'How to create a scrollable viewport in Visual Basic'
  130. Sub Form_Resize ()
  131.    vsrPosition.Move 0, 0, vsrPosition.Width, frmBitMap.ScaleHeight
  132.    picframe.Move vsrPosition.Width, 0, frmBitMap.ScaleWidth - VScroll1.Width - vsrPosition.Width, frmBitMap.ScaleHeight - HSCroll1.Height
  133.    picBitMap.Move 0, 0
  134.    ' Position the horizontal scroll bar.
  135.    HSCroll1.Top = picframe.Height
  136.    HSCroll1.Left = vsrPosition.Width
  137.    HSCroll1.Width = picframe.Width
  138.    ' Position the vertical scroll bar.
  139.    VScroll1.Top = 0
  140.    VScroll1.Left = picframe.Width + vsrPosition.Width
  141.    VScroll1.Height = picframe.Height
  142.    'Position the Arrows
  143.    ' Set the Max value for the scroll bars.
  144.    HSCroll1.Max = picBitMap.Width - picframe.Width
  145.    VScroll1.Max = picBitMap.Height - picframe.Height
  146.    ' Determine if child picture will fill up screen.
  147.    ' If so, then there is no need to use scroll bars.
  148.    VScroll1.Enabled = (picframe.Height < picBitMap.Height)
  149.    HSCroll1.Enabled = (picframe.Width < picBitMap.Width)
  150. End Sub
  151. Sub HScroll1_Change ()
  152.   ' picBitMap.Left is set to the negative of the value because
  153.   ' as you scroll the scroll bar to the right, the display
  154.   ' should move to the Left, showing more of the right
  155.   ' of the display, and vice-versa when scrolling to the
  156.   ' left.
  157.     'See form-resize event for more info
  158.    picBitMap.Left = -HSCroll1.Value
  159. End Sub
  160. Sub mnuDelete_Click ()
  161.     If picBitMap.ScaleHeight <= TotalButtonHeight + Bitmap.Border Then
  162.     MsgBox "Sorry! I can't delete the last button"
  163.     Exit Sub
  164.     End If
  165.     If Show_Message("DELETE") Then Exit Sub  'Check that a button has been click
  166.     Reset_BitMap 'make button normal (not inverted)
  167.     'Resize the swap & master bitmap picture. Copy all but the last button from the master bitmap
  168.     'Then copy the swap picture back into the master bitmap
  169.     picBitMap.Height = picBitMap.Height - TotalButtonHeight
  170.     picSwap.Width = picBitMap.Width
  171.     picSwap.Height = picBitMap.Height
  172.     Bitmap.Position = Bitmap.Position - TotalButtonHeight
  173.     BitBlt picSwap.hDC, 0, 0, picBitMap.ScaleWidth, picBitMap.ScaleHeight, picBitMap.hDC, 0, 0, SRCCOPY
  174.     picBitMap.Picture = picSwap.Image
  175.     picSwap = picCol16
  176.     picSwap.AutoRedraw = False
  177.     Bitmap.Changed = True
  178.     picBitMap.Refresh
  179. End Sub
  180. Sub mnuEdit_Click ()
  181.     If Clicked Then
  182.     If Show_Message("EDIT") Then Exit Sub 'is a button selected?
  183.     'Copy the button into the 'Up' button picture
  184.     BitBlt B(0).hDC, 0, 0, Bitmap.ButtonWidth, Bitmap.ButtonHeight, picBitMap.hDC, Bitmap.Border, vsrPosition + Bitmap.Border, NOTSRCCOPY
  185.     B(0).Refresh
  186.     frmButton!picDraw.Refresh
  187.     Bitmap.Position = picBitMap.ScaleHeight - (Bitmap.ButtonHeight + (Bitmap.Border * 2))
  188.     Editing = True
  189.     UpDated = False
  190.     mnuExit_Click
  191.     End If
  192. End Sub
  193. Sub mnuExit_Click ()
  194.     Reset_BitMap
  195.     frmBitMap.Hide
  196. End Sub
  197. Sub picBitMap_MouseUp (button As Integer, Shift As Integer, X As Single, Y As Single)
  198.     Changing = True 'Flag to stop vscrPosition altering the buttons
  199.     If Not Clicked Then
  200.     vsrPosition.Max = (picBitMap.ScaleHeight - TotalButtonHeight)
  201.     vsrPosition.SmallChange = TotalButtonHeight
  202.     vsrPosition.LargeChange = TotalButtonHeight
  203.     vsrPosition.Enabled = True
  204.     'initialize the swap picture
  205.     picSwap.AutoRedraw = True
  206.     picSwap.Width = picBitMap.Width
  207.     picSwap.Height = TotalButtonHeight + (getSystemMetrics(SM_CYBORDER) * 2)
  208.     End If
  209.     'Get the position of the top of the button
  210.     vsrPosition = (Y \ TotalButtonHeight) * TotalButtonHeight
  211.     If Clicked Then
  212.     'A button is already inverted so restore it to normal
  213.     BitBlt picBitMap.hDC, 0, LastPosition, picBitMap.ScaleWidth, TotalButtonHeight, 0&, 0, LastPosition, DSTINVERT
  214.     End If
  215.     LastPosition = vsrPosition   'Remember where the inverted button is
  216.     'Invert the selected button
  217.     BitBlt picBitMap.hDC, 0, vsrPosition, picBitMap.ScaleWidth, TotalButtonHeight, 0&, 0, vsrPosition, DSTINVERT
  218.     picBitMap.Refresh
  219.     Clicked = True
  220.     Changing = False
  221. End Sub
  222. Sub picBitMap_Resize ()
  223.     Form_Resize
  224. End Sub
  225. Sub Reset_BitMap ()
  226.     If Clicked Then
  227.     vsrPosition.Enabled = False
  228.     'One of the buttons is inverted so restore it to normal
  229.     BitBlt picBitMap.hDC, 0, LastPosition, picBitMap.ScaleWidth, TotalButtonHeight, 0&, 0, LastPosition, DSTINVERT
  230.     End If
  231.     Clicked = False
  232. End Sub
  233. Function Show_Message (Msg As String) As Integer
  234.     If vsrPosition <> picBitMap.ScaleHeight - (TotalButtonHeight + Bitmap.Border) Then
  235.         MsgBox "This programme can only " & Msg & " the last button" & CR & "in the Bitmap. Move the button to the bottom" & CR & "Then try again", 48
  236.         Show_Message = True
  237.     End If
  238. End Function
  239. Sub VScroll1_Change ()
  240.   ' picBitMap.Top is set to the negative of the value because
  241.   ' as you scroll the scroll bar down, the display
  242.   ' should move up, showing more of the bottom
  243.   ' of the display, and vice-versa when scrolling up.
  244.    'See form-resize event for more info
  245.    picBitMap.Top = -VScroll1.Value
  246. End Sub
  247. Sub vsrPosition_Change ()
  248.     If Changing Then Exit Sub
  249.     'Only allow steps of one button
  250.     If Abs(vsrPosition - LastPosition) <> TotalButtonHeight Then
  251.     vsrPosition = LastPosition
  252.     Exit Sub
  253.     End If
  254.     Bitmap.Changed = True
  255.     'Puts the button above into the swap picture
  256.     'then puts the current button into the position above
  257.     'then puts the swap picture into the current position
  258.     'then makes the position above, the current position
  259.     BitBlt picSwap.hDC, 0, 0, picSwap.ScaleWidth, TotalButtonHeight, picBitMap.hDC, 0, LastPosition, SRCCOPY
  260.     BitBlt picBitMap.hDC, 0, LastPosition, picSwap.ScaleWidth, TotalButtonHeight, picBitMap.hDC, 0, vsrPosition, SRCCOPY
  261.     BitBlt picBitMap.hDC, 0, vsrPosition, picSwap.ScaleWidth, TotalButtonHeight, picSwap.hDC, 0, 0, SRCCOPY
  262.     LastPosition = vsrPosition
  263.     picBitMap.Refresh
  264. End Sub
  265.